home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8508.arc / PENTATH.PLI < prev    next >
Text File  |  1986-09-14  |  4KB  |  160 lines
  1.  /*  The Pentathlon Program
  2.      Translated to PL/1 from the PASCAL version by Mark
  3.      Townsend & Robert Barnes.  The PASCAL versions were
  4.      translated from the C version of these routines by 
  5.      Michael Brian Bentley. Originally written by William 
  6.      J. Hunt for PC-TECH Journal readers everywhere.
  7.   */
  8.  
  9. pentathalon: proc options (main);                               
  10.  
  11. dcl (i,niter,ibench) bin fixed(15);
  12.  niter=100;
  13.  /* main program */
  14.  do ibench=1 to 4; 
  15.    put skip edit('100 iterations ', ibench)(skip,a, f(3));
  16.    put list('starting ');
  17.    call puttime;
  18.    do i = 1 to niter;           
  19.      if ibench=1 then call bench1;
  20.      if ibench=2 then call bench2;
  21.      if ibench=3 then call bench3;
  22.      if ibench=4 then call bench4;
  23.    end;
  24.    put skip list('finished ');                   
  25.    call puttime;
  26.  end;
  27.  put skip list ('create file for benchmark 5');
  28.  call makefile;
  29.  put skip list('starting I/O benchmark');
  30.  call puttime;
  31.  call bench5;
  32.  put skip list('finished ');                   
  33.  call puttime;
  34.  
  35.  
  36. bench1:procedure; /* floating point arithmetic benchmark */
  37.  
  38. dcl (i,j) bin fixed;
  39. dcl (x,y) (0:99) float,
  40.      z float;
  41.  
  42. do i = 0 to 99;
  43.   x(i) = i + 1;
  44.   y(i) = 3 + i;
  45. end;
  46. z = 0;
  47. do j = 0 to 9;
  48.   do i = 0 to 99;
  49.     z = z + x(i) * y(i);
  50.   end;
  51. end;
  52. end bench1;
  53. bench2:procedure; /* function calling benchmark */
  54.  
  55. dcl i bin fixed(15);
  56.  
  57. do i = 0 to 19999 ;
  58.    call dummy((i));    /* calls a dummy procedure */
  59.                        /* i doesn't change        */
  60. end;
  61.  
  62. dummy:procedure(pi);
  63. dcl pi bin fixed(15);
  64. pi = pi + 1;
  65. end;
  66. end bench2;
  67.  
  68. bench3:procedure;     /* string copy benchmark */
  69.  
  70. dcl  i bin fixed;  
  71. dcl  s(500) char(1);         
  72. dcl  s2(500) char(1);
  73.  
  74. do i=1 to 499;
  75.   s(i)='a';
  76. end;
  77. s(500)=ascii(0);          
  78.  
  79. do i = 1 to 100;
  80.   s2=s;
  81. end;
  82. end bench3;     
  83.  
  84. bench4: procedure ;        /* character count benchmark */
  85. dcl  i  bin fixed(15);
  86. dcl  s(500) char(1);      
  87. dcl  cnt(0:255) bin fixed;
  88.  
  89. /* bench4 - initialize string array for counting */
  90. do i = 1 to 500;   
  91.   s(i) = ascii(i);        
  92. end;
  93.  
  94. do i = 1 to 100; 
  95.   call count_char(s,cnt);
  96. end;
  97.  
  98. count_char:proc(strng,counts);                                                
  99. dcl strng(500) char(1);
  100. dcl counts(0:255) bin fixed;
  101. dcl  i bin fixed(15);
  102. dcl  c char(1);
  103. dcl  idx bin fixed;
  104.  
  105. do i=1 to 500;                                             
  106.   idx = rank(strng(i));
  107.   counts( idx ) = counts( idx ) + 1;
  108. end;
  109. end count_char; 
  110.  
  111. end bench4;
  112.  
  113. bench5:proc;        /* file copy with getc/putc */
  114.  
  115. dcl n bin fixed(15);     
  116. dcl (infile,outfile) file;
  117. dcl data char(1) var;
  118.  
  119. open file(infile) stream input title('test.in' );
  120. open file(outfile) stream output print title('test.out' );
  121. n = 0;
  122. on endfile(infile) goto exit;
  123. do while('1'b);                            
  124.   n = n + 1;
  125.   get file(infile) edit(data)(a(1));    
  126.   put file(outfile) edit(data)(a(1));
  127. end;
  128. exit:put skip;                                 
  129. put edit(n,' characters')(skip,f(7),a);
  130. close file(infile);       
  131. close file(outfile);        
  132. end bench5;
  133.  
  134. makefile:proc;           /* create a test file */
  135.         dcl  victim file;         
  136.         dcl  n bin fixed(15);         
  137.  
  138.         /* makefile */
  139.        open file(victim) stream output print title('test.in');
  140.        do n = 0 to 29999;             
  141.         put file(victim) edit('a')(a(1));
  142.        end;
  143.        close file(victim); 
  144. end;
  145. puttime: procedure;
  146. declare gettime    entry (pointer,pointer,pointer,pointer);
  147. declare    (hour,min,sec,fraction) fixed(7);
  148.  
  149. call gettime(addr(hour),addr(min),addr(sec),addr(fraction));
  150. put skip list('The time is now ');
  151. put edit(hour,':',min,':',sec,'.',fraction)
  152.         (f(2),a,f(2),a,f(2),a,f(2));
  153. end puttime;
  154.  
  155. end pentathalon;
  156.  
  157.  
  158.  
  159.  
  160.